home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
dspice0s
/
acsol.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-21
|
8KB
|
232 lines
/* acsol.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
lvntmp;
} tabinf_;
#define tabinf_1 tabinf_
struct {
integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt,
nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
} cirdat_;
#define cirdat_1 cirdat_
struct {
doublereal value[200000];
} blank_;
#define blank_1 blank_
/*< subroutine acsol >*/
/* Subroutine */ int acsol_()
{
/* System generated locals */
integer i_1, i_2;
doublereal d_1, d_2;
complex q_1;
/* Local variables */
extern /* Subroutine */ int cdiv_();
static integer iord, jord;
extern /* Subroutine */ int copy8_();
static integer i, j, k;
static doublereal ximag;
static integer locnn;
static doublereal xreal;
extern /* Subroutine */ int cmult_();
extern integer indxx_();
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
static integer loc;
/*< implicit double precision (a-h,o-z) >*/
/* this routine solves the circuit equations by performing a forward
*/
/* and backward substitution using the previously-computed lu factors. */
/* spice version 2g.6 sccsid=tabinf 3/15/83 */
/*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
/*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
/*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
/*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
/*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
/*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
/*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
/*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
/* spice version 2g.6 sccsid=cirdat 3/15/83 */
/*< common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
/*< 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
/* spice version 2g.6 sccsid=blank 3/15/83 */
/*< common /blank/ value(200000) >*/
/*< integer nodplc(64) >*/
/*< complex cvalue(32) >*/
/*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
/* forward substitution */
/*< do 20 i=2,nstop >*/
i_1 = cirdat_1.nstop;
for (i = 2; i <= i_1; ++i) {
/*< loc=i >*/
loc = i;
/*< iord=nodplc(irswpf+i) >*/
iord = nodplc[tabinf_1.irswpf + i - 1];
/*< 10 loc=nodplc(jcpt+loc) >*/
L10:
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< if (nodplc(jcolno+loc).ge.i) go to 20 >*/
if (nodplc[tabinf_1.jcolno + loc - 1] >= i) {
goto L20;
}
/*< j=nodplc(jcolno+loc) >*/
j = nodplc[tabinf_1.jcolno + loc - 1];
/*< jord=nodplc(irswpf+j) >*/
jord = nodplc[tabinf_1.irswpf + j - 1];
/*< call cmult(value(lynl+loc),value(imynl+loc), >*/
/*< 1 value(lvn+jord),value(imvn+jord),xreal,ximag) >*/
cmult_(&blank_1.value[tabinf_1.lynl + loc - 1], &blank_1.value[
tabinf_1.imynl + loc - 1], &blank_1.value[tabinf_1.lvn + jord
- 1], &blank_1.value[tabinf_1.imvn + jord - 1], &xreal, &
ximag);
/*< value(lvn+iord)=value(lvn+iord)-xreal >*/
blank_1.value[tabinf_1.lvn + iord - 1] -= xreal;
/*< value(imvn+iord)=value(imvn+iord)-ximag >*/
blank_1.value[tabinf_1.imvn + iord - 1] -= ximag;
/*< go to 10 >*/
goto L10;
/*< 20 continue >*/
L20:
;}
/* back substitution */
/*< i=nstop >*/
i = cirdat_1.nstop;
/*< iord=nodplc(irswpf+i) >*/
iord = nodplc[tabinf_1.irswpf + i - 1];
/*< jord=nodplc(icswpf+i) >*/
jord = nodplc[tabinf_1.icswpf + i - 1];
/*< locnn=indxx(iord,jord) >*/
locnn = indxx_(&iord, &jord);
/*< 30 call cdiv(value(lvn+iord),value(imvn+iord),value(lynl+locnn), >*/
/*< 1 value(imynl+locnn),value(lvn+iord),value(imvn+iord)) >*/
L30:
cdiv_(&blank_1.value[tabinf_1.lvn + iord - 1], &blank_1.value[
tabinf_1.imvn + iord - 1], &blank_1.value[tabinf_1.lynl + locnn -
1], &blank_1.value[tabinf_1.imynl + locnn - 1], &blank_1.value[
tabinf_1.lvn + iord - 1], &blank_1.value[tabinf_1.imvn + iord - 1]
);
/*< i=i-1 >*/
--i;
/*< if (i.le.1) go to 60 >*/
if (i <= 1) {
goto L60;
}
/*< iord=nodplc(irswpf+i) >*/
iord = nodplc[tabinf_1.irswpf + i - 1];
/*< loc=i >*/
loc = i;
/*< 35 loc=nodplc(jcpt+loc) >*/
L35:
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< 40 if (nodplc(jcolno+loc).ne.i) go to 35 >*/
/* L40: */
if (nodplc[tabinf_1.jcolno + loc - 1] != i) {
goto L35;
}
/*< locnn=loc >*/
locnn = loc;
/*< 50 loc=nodplc(jcpt+loc) >*/
L50:
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< if (loc.eq.0) go to 30 >*/
if (loc == 0) {
goto L30;
}
/*< j=nodplc(jcolno+loc) >*/
j = nodplc[tabinf_1.jcolno + loc - 1];
/*< jord=nodplc(irswpf+j) >*/
jord = nodplc[tabinf_1.irswpf + j - 1];
/*< call cmult(value(lynl+loc),value(imynl+loc), >*/
/*< 1 value(lvn+jord),value(imvn+jord),xreal,ximag) >*/
cmult_(&blank_1.value[tabinf_1.lynl + loc - 1], &blank_1.value[
tabinf_1.imynl + loc - 1], &blank_1.value[tabinf_1.lvn + jord - 1]
, &blank_1.value[tabinf_1.imvn + jord - 1], &xreal, &ximag);
/*< value(lvn+iord)=value(lvn+iord)-xreal >*/
blank_1.value[tabinf_1.lvn + iord - 1] -= xreal;
/*< value(imvn+iord)=value(imvn+iord)-ximag >*/
blank_1.value[tabinf_1.imvn + iord - 1] -= ximag;
/*< go to 50 >*/
goto L50;
/* reorder solution vector */
/*< 60 do 70 i=1,nstop >*/
L60:
i_1 = cirdat_1.nstop;
for (i = 1; i <= i_1; ++i) {
/*< j=nodplc(icswpr+i) >*/
j = nodplc[tabinf_1.icswpr + i - 1];
/*< k=nodplc(irswpf+j) >*/
k = nodplc[tabinf_1.irswpf + j - 1];
/*< value(ndiag+i)=value(lvn+k) >*/
blank_1.value[tabinf_1.ndiag + i - 1] = blank_1.value[tabinf_1.lvn +
k - 1];
/*< value(ndiag+i+nstop)=value(imvn+k) >*/
blank_1.value[tabinf_1.ndiag + i + cirdat_1.nstop - 1] =
blank_1.value[tabinf_1.imvn + k - 1];
/*< 70 continue >*/
/* L70: */
}
/*< call copy8(value(ndiag+1),value(lvn+1),nstop) >*/
copy8_(&blank_1.value[tabinf_1.ndiag], &blank_1.value[tabinf_1.lvn], &
cirdat_1.nstop);
/*< call copy8(value(ndiag+1+nstop),value(imvn+1),nstop) >*/
copy8_(&blank_1.value[tabinf_1.ndiag + 1 + cirdat_1.nstop - 1], &
blank_1.value[tabinf_1.imvn], &cirdat_1.nstop);
/*< do 120 i=2,nstop >*/
i_1 = cirdat_1.nstop;
for (i = 2; i <= i_1; ++i) {
/*< cvalue(lcvn+i)=cmplx(sngl(value(lvn+i)),sngl(value(imvn+i))) >*/
i_2 = tabinf_1.lcvn + i - 1;
d_1 = blank_1.value[tabinf_1.lvn + i - 1];
d_2 = blank_1.value[tabinf_1.imvn + i - 1];
q_1.r = d_1, q_1.i = d_2;
cvalue[i_2].r = q_1.r, cvalue[i_2].i = q_1.i;
/*< 120 continue >*/
/* L120: */
}
/*< cvalue(lcvn+1)=cmplx(0.0e0,0.0e0) >*/
i_1 = tabinf_1.lcvn;
cvalue[i_1].r = (float)0., cvalue[i_1].i = (float)0.;
/* finished */
/*< return >*/
return 0;
/*< end >*/
} /* acsol_ */
#undef cvalue
#undef nodplc